home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / examples / menufrob.lsp < prev    next >
Encoding:
Text File  |  1991-10-06  |  9.3 KB  |  223 lines
  1. ; -*-Lisp-*-
  2. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  3. ;
  4. ; File:         menufrob.lsp
  5. ; RCS:          $Header: menufrob.lsp,v 1.1 91/10/05 21:36:58 mayer Exp $
  6. ; Description:  Dynamically altering XmCreateSimple...() created menus...
  7. ; Author:       Niels Mayer, HPLabs
  8. ; Created:      Sat Oct  5 21:34:39 1991
  9. ; Modified:     Sat Oct  5 21:36:00 1991 (Niels Mayer) mayer@hplnpm
  10. ; Language:     Lisp
  11. ; Package:      N/A
  12. ; Status:       X11r5 contrib tape release
  13. ;
  14. ; WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. ; XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. ;
  17. ; Permission to use, copy, modify, distribute, and sell this software and its
  18. ; documentation for any purpose is hereby granted without fee, provided that
  19. ; the above copyright notice appear in all copies and that both that
  20. ; copyright notice and this permission notice appear in supporting
  21. ; documentation, and that the name of Hewlett-Packard and Niels Mayer not be
  22. ; used in advertising or publicity pertaining to distribution of the software
  23. ; without specific, written prior permission.  Hewlett-Packard and Niels Mayer
  24. ; makes no representations about the suitability of this software for any
  25. ; purpose.  It is provided "as is" without express or implied warranty.
  26. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  27.  
  28. ; To: OSF/Motif source licencee mailing List <motif-talk@osf.org>
  29. ; Subject: Re: XmCreateSimpleWhatever 
  30. ; In-Reply-To: Your message of Thu, 05 Sep 91 08:33:01 -0600
  31. ; Organization: Hewlett-Packard Labs, Software & Systems Lab, Palo Alto, CA.
  32. ; X-Mailer: mh6.7
  33. ; Date: Thu, 05 Sep 91 16:28:57 -0700
  34. ; Message-Id: <25898.684113337@hplnpm.hpl.hp.com>
  35. ; From: "Niels P. Mayer" <mayer@hplnpm.hpl.hp.com>
  36. ; 
  37. ; >    May be your example is incomplete or I was not clear enough.
  38. ; >    The problems I see are not at *creation* time - any tool can deal
  39. ; >    with the creation.
  40. ; >    The problems I see are with dynamics. If I use a "Simple" style
  41. ; >    constructor, I use one set of controls. But I can't use the same
  42. ; >    set of controls to alter (change, modify) created object(s).
  43. ; >    I could use a different set (RowColumn controls in case of menus),
  44. ; >    but how do I tell that to a generic tool ? Do I have to describe
  45. ; >    such an objectt twice: intialization controls versus runtime controls?
  46. ; >
  47. ; >    Note that my tools typically rely on XtGetResourceLists from any object
  48. ; >    they control - which does not quite work with XmCreateSimple ....
  49. ; 
  50. ; For your case, I think the answer is yes, you have to describe the object
  51. ; twice, and write lots of kludges because many composite/compound widgets in
  52. ; Motif do not offer a consistent view of the world based on resources alone.
  53. ; The resources-are-everything assumption may have been sufficient for Xaw or
  54. ; Xw... but, IMHO, they are an oversimplification when dealing with Motif.
  55. ; 
  56. ; Thus, you may want to punt on XmCreateSimple*() routines in some "generic
  57. ; tools" especially ones that rely entirely on resources, such as WCL, or
  58. ; ones that provide a language expressive enough to only cover widget
  59. ; creation and static bindings (UIL, WCL).
  60. ; 
  61. ; As I mentioned, the XmCreateSimple*() routines are oriented towards
  62. ; creation of STATIC {pulldown,popup,option} menus, radioboxes, and menubars.
  63. ; For menus which change dynamically at runtime, you may be better off using
  64. ; the "traditional" menu creation routines.
  65. ; 
  66. ; Perhaps I don't understand what you're getting at here -- you will use the
  67. ; traditional runtime controls to do dynamic changes, the main difference is
  68. ; that you cannot directly access the children widgets created by
  69. ; XmCreateSimple*(). The other difference is that the
  70. ; XmCreateSimple*()-specific resources are CREATE-TIME only resources. The
  71. ; arrays of button types, button names, accelerator texts, accelerators, etc
  72. ; are indexed-through at create-time and the appropriate values from each
  73. ; array are passed on to each child created by the XmCreateSimple*()
  74. ; routines. To make any dynamic changes, you'll have to access the child
  75. ; widgets directly using traditional means (many of which lie outside the
  76. ; language-expressivity of WCL/UIL).
  77. ; 
  78. ; However, that's not to say that you cannot do dynamic changes to a menu
  79. ; that is created via, say, XmCreateSimplePulldownMenu(). With respect to WCL
  80. ; and other resource-based tools, you'll need to look up the desired button
  81. ; with resource name "button_<#>" where 0 <= <#> < XmNbuttonCount.  When
  82. ; programming in C, or with WINTERP, you'll need to access the children of
  83. ; the simple menu via XmRowColumn resources XmNchildren/XmNnumChildren.
  84. ; 
  85. ; For example, to grey-out the "Save" button within the menu-code I posted
  86. ; yesterday, I just evaluate the following WINTERP expression:
  87. ;     (send (aref (send pulldown_w :get_children) 3) :set_values
  88. ;           :XMN_SENSITIVE nil)
  89. ; And the button will immediately change to insensitive (aka greyed-out).
  90. ; 
  91. ; The code above just accesses the child widget at index 3 retrieved from the
  92. ; XmNchildren resource (:get_children) of pulldown_w. (pulldown_w is bound to
  93. ; a row/col instance created via XmCreateSimplePulldownMenu()). Once the
  94. ; child widget is accessed, the code sends a message to do an XtSetValues()
  95. ; (send ... :set_values ...) on resource XmNsensitive (:XMN_SENSITIVE),
  96. ; setting it to FALSE (nil).
  97. ; 
  98. ; One can just as easily go through and dynamically change the resources
  99. ; XmNlabelString, XmNmnemonic, XmNacceleratorText, and XmNaccelerators on all
  100. ; the widgets contained in the pulldown widget bound to 'pulldown_w' by
  101. ; evaluating the following code:
  102. ; 
  103. ; (let*                    
  104. ;     (;; declare, bind, initialize local variables
  105. ;      (children    (send pulldown_w :get_children)) ;retrieve XmNchildren array
  106. ;      (length    (length children))
  107. ;      )
  108. ;   ;; loop through children
  109. ;   (do
  110. ;    ;; Declare variables local to do loop, initialize, specify incrementor
  111. ;    ((i 0 (1+ i)))
  112. ;    ;; Test for loop termination
  113. ;    ((<= length i)            
  114. ;     )
  115. ;    ;; Loop body
  116. ;    ;; Note: in the code below,
  117. ;    ;; (format nil "...~A..." i) is similar to the C code
  118. ;    ;; sprintf(buf, "...%d..." i)
  119. ;    (send (aref children i) :set_values    ;XtSetValues() on i-th child
  120. ;      :XMN_LABEL_STRING    (format nil "menu: ~A" i)
  121. ;      :XMN_MNEMONIC        (format nil "~A" i)
  122. ;      :XMN_ACCELERATOR_TEXT    (format nil "^~A" i)
  123. ;      :XMN_ACCELERATORS      (format nil "Ctrl<Key>~A: Lisp(print ~A)" i i)
  124. ;      )
  125. ;    )                    ;end-do
  126. ;   )                    ;end-let*
  127. ; 
  128. ; This will change the menu to look like
  129. ;         menu: _0_    ^0
  130. ;         menu: _1_    ^1
  131. ;         menu: _2_    ^2
  132. ;         menu: _3_    ^3
  133. ;         menu: _4_    ^4
  134. ;         menu: _5_    ^5
  135. ; 
  136. ; (The only problem with the above code is that the accelerators do not get
  137. ; automatically installed on other widgets. This needs to be done with
  138. ; XtInstallAccelerators()...)
  139.  
  140.  
  141. (load "rc-shell")
  142.  
  143. (setq menubar_w
  144.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :managed :simple_menu_bar
  145.         "menubar" rc_w
  146.         :XMN_BUTTON_COUNT 5        ;create five cascadebuttons in menubar
  147.         :XMN_BUTTONS
  148.         #("Files" "Edit" "Fold" "Spindle" "Mutilate")
  149.         :XMN_BUTTON_MNEMONICS
  150.         #(#\F     #\E    #\o    #\S       #\M)
  151.         ))
  152.  
  153. (setq pulldown_w
  154.       (send XM_ROW_COLUMN_WIDGET_CLASS :new :simple_pulldown_menu
  155.         "pulldown" menubar_w
  156.         :XMN_POST_FROM_BUTTON 0    ;post pulldown from menubar's "Files"
  157.         :XMN_BUTTON_COUNT 5        ;create five buttons in this pulldown
  158.         :XMN_BUTTONS
  159.             #("Quit" "Open" "Open in New Window" "Save" "Save As")
  160.         :XMN_BUTTON_MNEMONICS
  161.             #(#\Q    #\O    #\N                  #\S    #\A)
  162.         :XMN_BUTTON_MNEMONIC_CHAR_SETS
  163.             #("" "" "ISO8859-1" "ISO8859-1" "ISO8859-1")
  164.         :XMN_BUTTON_ACCELERATORS
  165.             #("Ctrl<Key>C" "Ctrl<Key>F" "Ctrl<Key>O" "Ctrl<Key>S" "Ctrl<Key>W")
  166.         :XMN_BUTTON_ACCELERATOR_TEXT
  167.             #("^C" "^F" "^O" "^S" "^W")
  168.         :XMN_BUTTON_TYPE
  169.             #(:PUSHBUTTON :PUSHBUTTON :PUSHBUTTON :PUSHBUTTON :PUSHBUTTON)
  170.         ))
  171.  
  172.  
  173. (send pulldown_w :add_callback :XMN_ENTRY_CALLBACK ;use instead of XmNsimpleCallback
  174.       '(CALLBACK_ENTRY_WIDGET)        ;gets bound to widget causing c.b.
  175.       '(
  176.     ;; (send CALLBACK_ENTRY_WIDGET :name)==XtName() returns "button_<#>"
  177.     ;; where <#> is 0 ... (:XMN_BUTTON_COUNT - 1).
  178.     ;; we use 'read' to return the FIXNUM <#> after truncating the
  179.     ;; 7 chars "button_" from the front of the string.
  180.     (case (read (make-string-input-stream
  181.              (send CALLBACK_ENTRY_WIDGET :name) 7))
  182.           (0 (format T "Quit Function Called\n"))
  183.           (1 (format T "Open Function Called\n"))
  184.           (2 (format T "Open in New Window Function Called\n"))
  185.           (3 (format T "Save Function Called\n"))
  186.           (4 (format T "Save As Function Called\n"))
  187.           (T (format T "Error\n")))
  188.     ))
  189.  
  190.  
  191. ;;
  192. ;; do interactive changes
  193. ;;
  194.  
  195. (let*                    
  196.     (;; declare and bind local variables
  197.      (children    (send pulldown_w :get_children)) ;XtGetValues(XmNchildren/XmNnumChildren)
  198.      (length    (length children))
  199.      )
  200.  
  201.   ;; loop through children
  202.   (do
  203.    ;; set up local loop variables and incrementors
  204.    ((i 0 (1+ i)))
  205.    ;; test and return value
  206.    ((<= length i)            
  207.     )
  208.    ;; loop body
  209.    (send (aref children i) :set_values    ;XtSetValues() on i-th child
  210.      :XMN_LABEL_STRING    (format nil "menu: ~A" i)
  211.      :XMN_MNEMONIC        (format nil "~A" i)
  212.      :XMN_ACCELERATOR_TEXT    (format nil "^~A" i)
  213.      :XMN_ACCELERATORS      (format nil "Ctrl<Key>~A: Lisp(print ~A)" i i)
  214.      )
  215.    )                    ;end-do
  216.   )                    ;end-let*
  217.  
  218.  
  219. (send (aref (send pulldown_w :get_children) 3) :set_values
  220.       :XMN_SENSITIVE t)
  221.  
  222. (send (aref (send pulldown_w :get_children) 3) :destroy)
  223.